Dependencies & functions

# dependencies
library(tidyverse)
library(knitr)
library(kableExtra)
library(brms)
library(parallel)
library(tidybayes)
library(bayestestR)
library(sjPlot)
library(psych)
library(rsample)
library(broom)
library(purrr)
library(IATscores)
library(lavaan)
library(semTools)
library(modelr)
library(furrr)
library(caret)
library(e1071)

# set up parallel processing
future::plan(multiprocess)

# knitr options
options(knitr.kable.NA = "/")

# set seed for bootstrapping reproducibility
set.seed(42)

# create necessary folder
dir.create("models")

Exclusions & standaridization

All dependent variables (self-reported evaluations and IAT D2 scores) were standardized (by 1 SD) after exclusions and prior to analysis condition (see Lorah, 2018: https://doi.org/10.1186/s40536-018-0061-2). This was done within each level of both IV (i.e., by Source Valence condition [positive vs. negative], and by Video Content [Genuine vs. Deepfaked]). As such, the beta estimates obtained from the Bayesian models (see research questions and data analysis plans below) therefore represent standardized beta values (\(\beta\) rather than \(B\)). More importantly, the nature of this standardization makes these estimates somewhat comparable to the frequentist standardized effect size metric Cohen’s \(d\), as both are a differences in (estimated) means as a proportion of SD although they should not be treated as equivalent. Effect size magnitude here can therefore be thought of along comparable scales as Cohen’s \(d\). As such, to aid interpretability, the point estimates of effect size will be reported as \(\delta\) (delta).

# full data
data_processed <- read.csv("../data/processed/4_data_participant_level_with_hand_scoring.csv") %>%
  # include only experiment 7
  filter(experiment == 7) %>%
  # set factor levels for t test comparisons
  mutate(source_valence = fct_relevel(source_valence,
                                      "negative",
                                      "positive"),
         experiment_condition = fct_relevel(experiment_condition,
                                            "genuine",
                                            "deepfaked"),
         deepfake_detection_closed = fct_relevel(tolower(deepfake_detection_closed),
                                                 "genuine",
                                                 "deepfaked"),
         deepfake_awareness_closed = fct_relevel(deepfake_awareness_closed,
                                                 "unaware",
                                                 "aware"))

# apply exclusions
data_after_exclusions <- data_processed %>%
  filter(exclude_subject == FALSE & 
           exclude_implausible_intervention_linger == FALSE) %>%
  # standardize DVs by 1SD within each experiment and their conditions
  group_by(experiment, experiment_condition, source_valence) %>%
  mutate(mean_self_reported_evaluation = mean_self_reported_evaluation/sd(mean_self_reported_evaluation),
         IAT_D2 = IAT_D2/sd(IAT_D2),
         mean_intentions = mean_intentions/sd(mean_intentions)) %>%
  ungroup()

# item level for iat
data_iat_item_level_after_exclusions <- read_csv("../data/processed/2.4_data_iat_item_level.csv") %>%
  # exclude the same participants as above
  semi_join(rename(data_after_exclusions, subject_original = subject), by = "subject_original")

Distributions

ggplot(data_after_exclusions, aes(mean_self_reported_evaluation)) +
  geom_density() +
  facet_wrap( ~ experiment_condition + source_valence) +
  ggtitle("Standardized scores")

ggplot(data_after_exclusions, aes(IAT_D2)) +
  geom_density() +
  facet_wrap( ~ experiment_condition + source_valence) +
  ggtitle("Standardized scores")

ggplot(data_after_exclusions, aes(mean_intentions)) +
  geom_density() +
  facet_wrap( ~ experiment_condition + source_valence) +
  ggtitle("Standardized scores")

Demographics

Pre exclussion

data_processed %>%
  summarise(n = n(),
            excluded_n = sum(exclude_subject != FALSE | 
                               exclude_implausible_intervention_linger != FALSE, na.rm = TRUE),
            excluded_percent = (excluded_n / n) *100) %>%
  mutate_if(is.numeric, round, digits = 1) %>%
  kable(align = "c") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

n	excluded_n	excluded_percent
828	192	23.2

Post exclusions

data_after_exclusions %>%
  summarise(n = n(),
            age_mean = mean(age, na.rm = TRUE),
            age_sd = sd(age, na.rm = TRUE)) %>%
  mutate_if(is.numeric, round, digits = 1) %>%
  kable(align = "c") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

n	age_mean	age_sd
635	35.7	13

data_after_exclusions %>%
  count(gender) %>%
  spread(gender, n) %>%
  kable(knitr.kable.NA = "/", align = "c") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

female	male	Non-binary	Prefer to self-discribe
387	240	7	1

Internal consistency

Self-reported evaluations

model_sr <- "scale =~ ratings_bad_good + ratings_dislike_like + ratings_negative_positive" 

fit_cfa_sr <- data_after_exclusions %>%
  cfa(model = model_sr, data = .) 

results_reliability_sr <- fit_cfa_sr %>%
  reliability() %>%
  as.data.frame() %>%
  rownames_to_column(var = "metric") %>%
  select(metric, estimate = scale) %>%
  filter(metric %in% c("alpha",
                       "omega2")) %>%
  mutate(metric = recode(metric,
                         "alpha" = "alpha",
                         "omega2" = "omega_t"),
         estimate = round(estimate, 3))

results_reliability_sr %>%
  kable(knitr.kable.NA = "/", align = "c") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

metric	estimate
alpha	0.987
omega_t	0.987

IAT

split half

results_iat_split_half_reliability <- data_iat_item_level_after_exclusions %>%
  SplitHalf.D2(IATdata = .) %>%
  mutate(algorithm = ifelse(algorithm == "p2112", "D2", algorithm),
         splithalf = round(splithalf, 3))

## [1] "2020-12-08 23:30:14: Applying parameter P4 = dist"
## [1] "2020-12-08 23:30:14: Applying parameters P1 and P2"
## [1] "2020-12-08 23:30:14: Applying parameter P3 = dscore"
## [1] "2020-12-08 23:30:14: Applying parameters P1 and P2"
## [1] "2020-12-08 23:30:14: Applying parameter P3 = dscore"
## [1] "2020-12-08 23:30:14: IAT scores have been computed"
## [1] "2020-12-08 23:30:14: Applying parameter P4 = dist"
## [1] "2020-12-08 23:30:14: Applying parameters P1 and P2"
## [1] "2020-12-08 23:30:14: Applying parameter P3 = dscore"
## [1] "2020-12-08 23:30:15: Applying parameters P1 and P2"
## [1] "2020-12-08 23:30:15: Applying parameter P3 = dscore"
## [1] "2020-12-08 23:30:15: IAT scores have been computed"

results_iat_split_half_reliability %>%
  kable(knitr.kable.NA = "/", align = "c") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

algorithm	splithalf
D2	0.862

Behavioral intentions

model_bi <- "scale =~ behavioral_intentions_share + behavioral_intentions_subscribe + behavioral_intentions_recommend" 

fit_cfa_bi <- data_after_exclusions %>%
  cfa(model = model_bi, data = .) 

results_reliability_bi <- fit_cfa_bi %>%
  reliability() %>%
  as.data.frame() %>%
  rownames_to_column(var = "metric") %>%
  select(metric, estimate = scale) %>%
  filter(metric %in% c("alpha",
                       "omega2")) %>%
  mutate(metric = recode(metric,
                         "alpha" = "alpha",
                         "omega2" = "omega_t"),
         estimate = round(estimate, 3))

results_reliability_bi %>%
  kable(knitr.kable.NA = "/", align = "c") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

metric	estimate
alpha	0.939
omega_t	0.939

RQ1 & 2: Can online content establish first impressions towards a novel individual?; Are Deepfakes just as good as genuine online content at establishing first impressions?

Analyses employ Bayesian linear models with source_valence, experiment_condition and their interaction as IVs. This could therefore be described as akin to a Bayesian ANOVA.
DVs were standardize as noted above, and as such fitted model estimates represent standardized beta values (which due to the specifics of the standardization have comparable [but not exact] interpretation as Cohen’s d values).
Bayesian p values are also reported: these are on a similar scale to frequentist p values, but technically are 1 minus the posterior probability that the effect is greater than 0, i.e., \(1 - P(\beta>0)\).
Inspection of the posterior distributions allow us to infer that we employed weak priors placed on all parameters (normal distribution with M = 0 and SD = 10). Inspection of the chains indicated good convergence in all cases.

H1 hypotheses were tested using a Bayesian linear model to estimate a 95% Credible Interval on standardized effect size change in evaluations between Source Valence conditions. Credible Intervals whose lower bounds were > 0 were considered evidence in support of a given hypothesis.

For H2, if the lower bound of the 95% CI of the genuine condition is < the lower bound of the 90% CI of the Deepfaked condition (i.e., the difference between Source Valence conditions in each subgroups), this as considered evidence in support of the alternative hypothesis (i.e., evidence of non-inferiority in estimated means; that Deepfakes are as good as genuine content).

Sample sizes

data_after_exclusions %>%
  select(source_valence, 
         experiment_condition) %>%
  drop_na() %>%
  count(experiment_condition,
        source_valence) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

experiment_condition	source_valence	n
genuine	negative	155
genuine	positive	149
deepfaked	negative	160
deepfaked	positive	171

Self-reported evaluations

Fit model

fit_confirmatory_selfreport <-
  brm(formula = mean_self_reported_evaluation ~ source_valence * experiment_condition,
      family = gaussian(),
      data    = data_after_exclusions,
      file    = "models/fit_confirmatory_selfreport",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_selfreport)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_self_reported_evaluation ~ source_valence * experiment_condition 
##    Data: data_after_exclusions (Number of observations: 635) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                                                      Estimate Est.Error
## Intercept                                               -1.29      0.08
## source_valencepositive                                   2.59      0.12
## experiment_conditiondeepfaked                           -0.13      0.11
## source_valencepositive:experiment_conditiondeepfaked    -0.22      0.16
##                                                      l-95% CI u-95% CI Rhat
## Intercept                                               -1.44    -1.13 1.00
## source_valencepositive                                   2.36     2.82 1.00
## experiment_conditiondeepfaked                           -0.35     0.10 1.00
## source_valencepositive:experiment_conditiondeepfaked    -0.53     0.09 1.00
##                                                      Bulk_ESS Tail_ESS
## Intercept                                               14299    18178
## source_valencepositive                                  12792    16246
## experiment_conditiondeepfaked                           12963    16691
## source_valencepositive:experiment_conditiondeepfaked    11313    15687
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     1.00      0.03     0.95     1.06 1.00    19249    17433
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_selfreport, ask = FALSE)

Check informativeness of prior

Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.

check_prior(fit_confirmatory_selfreport) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative
b_experiment_conditiondeepfaked	uninformative
b_source_valencepositive.experiment_conditiondeepfaked	uninformative

Interpret posteriors

# plot_model(fit_confirmatory_selfreport)
plot_model(fit_confirmatory_selfreport, type = "pred", terms = c("source_valence", "experiment_condition"))

# percent moderation
draws_sr <-
  bind_cols(
    select(spread_draws(fit_confirmatory_selfreport, b_source_valencepositive), b_source_valencepositive),
    select(spread_draws(fit_confirmatory_selfreport, b_experiment_conditiondeepfaked), b_experiment_conditiondeepfaked),
    select(spread_draws(fit_confirmatory_selfreport, `b_source_valencepositive:experiment_conditiondeepfaked`), `b_source_valencepositive:experiment_conditiondeepfaked`)
  ) %>%
  rename(main_valence = b_source_valencepositive,
         main_experiment_condition = b_experiment_conditiondeepfaked,
         interaction = `b_source_valencepositive:experiment_conditiondeepfaked`) %>%
  mutate(effect_genuine = main_valence,
         effect_deepfaked = main_valence + interaction,
         #percent_moderation = (main_experiment_condition + interaction)/main_valence *100,  # alt method, same result
         percent_comparison = (effect_deepfaked/effect_genuine)*100)

# results
estimates_sr <-
  map_estimate(draws_sr) %>%
  full_join(bayestestR::hdi(draws_sr, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_sr, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_sr %>%
              select(-percent_comparison) %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper,
         CI_90_lower, CI_90_upper, p)

# results table
estimates_sr %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
main_valence	2.60	2.36	2.81	2.40	2.78	0.0000000
main_experiment_condition	-0.12	-0.34	0.10	-0.31	0.06	0.1314286
interaction	-0.21	-0.53	0.09	-0.49	0.04	0.0815000
effect_genuine	2.60	2.36	2.81	2.40	2.78	0.0000000
effect_deepfaked	2.35	2.15	2.59	2.18	2.55	0.0000000
percent_comparison	91.32	80.18	103.31	81.90	101.33	/

# hypothesis testing
H1a <- ifelse((estimates_sr %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H1b <- ifelse((estimates_sr %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H2a <- ifelse((estimates_sr %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_90_lower)) > 
                (estimates_sr %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)), 
              "Accepted", "Rejected")

comparison_string_sr <-
  paste0("Deepfakes are ",
         estimates_sr %>% filter(Parameter == "percent_comparison") %>% pull(MAP_Estimate) %>% round(1),
         "% (95% CI [",
         estimates_sr %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_lower) %>% round(1),
         ", ",
         estimates_sr %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_upper) %>% round(1),
         "]) as effective as genuine content in establishing self-reported evaluations")

H1a

The content of the genuine videos (i.e., Source Valence) will influence participants’ self-reported evaluations.

Result: Accepted

H1b

The content of the Deepfaked videos (i.e., Source Valence) will influence participants’ self-reported evaluations.

Result: Accepted

H2a

Change in self-reported evaluations (i.e., between Source Valence conditions) induced by Deepfaked video content will be non-inferior to genuine content.

Result: Rejected. Deepfakes are 91.3% (95% CI [80.2, 103.3]) as effective as genuine content in establishing self-reported evaluations.

Implicit

Fit model

fit_confirmatory_implicit <-
  brm(formula = IAT_D2 ~ source_valence * experiment_condition,
      family = gaussian(),
      data    = data_after_exclusions,
      file    = "models/fit_confirmatory_implicit",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_implicit)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: IAT_D2 ~ source_valence * experiment_condition 
##    Data: data_after_exclusions (Number of observations: 635) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                                                      Estimate Est.Error
## Intercept                                               -0.04      0.08
## source_valencepositive                                   1.39      0.12
## experiment_conditiondeepfaked                            0.17      0.11
## source_valencepositive:experiment_conditiondeepfaked    -0.03      0.16
##                                                      l-95% CI u-95% CI Rhat
## Intercept                                               -0.20     0.11 1.00
## source_valencepositive                                   1.16     1.61 1.00
## experiment_conditiondeepfaked                           -0.05     0.39 1.00
## source_valencepositive:experiment_conditiondeepfaked    -0.35     0.28 1.00
##                                                      Bulk_ESS Tail_ESS
## Intercept                                               14281    18619
## source_valencepositive                                  12853    16815
## experiment_conditiondeepfaked                           13230    16644
## source_valencepositive:experiment_conditiondeepfaked    11380    15882
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     1.00      0.03     0.95     1.06 1.00    19510    17391
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_implicit, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_implicit) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative
b_experiment_conditiondeepfaked	uninformative
b_source_valencepositive.experiment_conditiondeepfaked	uninformative

Interpret posteriors

#plot_model(fit_confirmatory_implicit)
plot_model(fit_confirmatory_implicit, type = "pred", terms = c("source_valence", "experiment_condition"))

# percent moderation
draws_imp <-
  bind_cols(
    select(spread_draws(fit_confirmatory_implicit, b_source_valencepositive), b_source_valencepositive),
    select(spread_draws(fit_confirmatory_implicit, b_experiment_conditiondeepfaked), b_experiment_conditiondeepfaked),
    select(spread_draws(fit_confirmatory_implicit, `b_source_valencepositive:experiment_conditiondeepfaked`), `b_source_valencepositive:experiment_conditiondeepfaked`)
  ) %>%
  rename(main_valence = b_source_valencepositive,
         main_experiment_condition = b_experiment_conditiondeepfaked,
         interaction = `b_source_valencepositive:experiment_conditiondeepfaked`) %>%
  mutate(effect_genuine = main_valence,
         effect_deepfaked = main_valence + interaction,
         #percent_moderation = (main_experiment_condition + interaction)/main_valence *100,  # alt method, same result
         percent_comparison = (effect_deepfaked/effect_genuine)*100)

# results table
estimates_imp <-
  map_estimate(draws_imp) %>%
  full_join(bayestestR::hdi(draws_imp, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_imp, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_imp %>%
              select(-percent_comparison) %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper,
         CI_90_lower, CI_90_upper, p)

estimates_imp %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
main_valence	1.37	1.17	1.62	1.19	1.57	0.0000000
main_experiment_condition	0.18	-0.05	0.39	-0.02	0.35	0.0697857
interaction	-0.03	-0.35	0.28	-0.30	0.23	0.4175714
effect_genuine	1.37	1.17	1.62	1.19	1.57	0.0000000
effect_deepfaked	1.36	1.14	1.57	1.17	1.53	0.0000000
percent_comparison	96.68	76.05	121.10	78.88	116.39	/

# hypothesis testing
H1c <- ifelse((estimates_imp %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H1d <- ifelse((estimates_imp %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H2b <- ifelse((estimates_imp %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_90_lower)) > 
                (estimates_imp %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)), 
              "Accepted", "Rejected")

comparison_string_imp <-
  paste0("Deepfakes are ",
         estimates_imp %>% filter(Parameter == "percent_comparison") %>% pull(MAP_Estimate) %>% round(1), 
         "% (95% CI [",
         estimates_imp %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_lower) %>% round(1),
         ", ",
         estimates_imp %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_upper) %>% round(1),
         "]) as effective as genuine content in establishing self-reported evaluations")

H1c

The content of the genuine videos (i.e., Source Valence) will influence participants’ IAT D2 scores.

Result: Accepted

H1d

The content of the Deepfaked videos (i.e., Source Valence) will influence participants’ IAT D2 scores.

Result: Accepted

H2b

Change in IAT D2 scores (i.e., between Source Valence conditions) induced by Deepfaked video content will be non-inferior to genuine content.

Result: Accepted. Deepfakes are 96.7% (95% CI [76.1, 121.1]) as effective as genuine content in establishing self-reported evaluations.

Behavioural intentions

Fit model

fit_confirmatory_intentions <-
  brm(formula = mean_intentions ~ source_valence * experiment_condition, # no random effect for experiment as only exp 6 assessed intentions
      family = gaussian(),
      data    = data_after_exclusions,
      file    = "models/fit_confirmatory_intentions",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_intentions)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_intentions ~ source_valence * experiment_condition 
##    Data: data_after_exclusions (Number of observations: 635) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                                                      Estimate Est.Error
## Intercept                                               -4.84      0.08
## source_valencepositive                                   2.59      0.11
## experiment_conditiondeepfaked                           -0.43      0.11
## source_valencepositive:experiment_conditiondeepfaked     0.10      0.16
##                                                      l-95% CI u-95% CI Rhat
## Intercept                                               -5.00    -4.68 1.00
## source_valencepositive                                   2.36     2.81 1.00
## experiment_conditiondeepfaked                           -0.65    -0.20 1.00
## source_valencepositive:experiment_conditiondeepfaked    -0.22     0.41 1.00
##                                                      Bulk_ESS Tail_ESS
## Intercept                                               12719    17823
## source_valencepositive                                  11272    14831
## experiment_conditiondeepfaked                           11101    15664
## source_valencepositive:experiment_conditiondeepfaked     9559    13598
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     1.00      0.03     0.95     1.06 1.00    19590    17095
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_intentions, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_intentions) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative
b_experiment_conditiondeepfaked	uninformative
b_source_valencepositive.experiment_conditiondeepfaked	uninformative

Interpret posteriors

#plot_model(fit_confirmatory_intentions)
plot_model(fit_confirmatory_intentions, type = "pred", terms = c("source_valence", "experiment_condition"))

# percent moderation
draws_intentions <-
  bind_cols(
    select(spread_draws(fit_confirmatory_intentions, b_source_valencepositive), b_source_valencepositive),
    select(spread_draws(fit_confirmatory_intentions, b_experiment_conditiondeepfaked), b_experiment_conditiondeepfaked),
    select(spread_draws(fit_confirmatory_intentions, `b_source_valencepositive:experiment_conditiondeepfaked`), `b_source_valencepositive:experiment_conditiondeepfaked`)
  ) %>%
  rename(main_valence = b_source_valencepositive,
         main_experiment_condition = b_experiment_conditiondeepfaked,
         interaction = `b_source_valencepositive:experiment_conditiondeepfaked`) %>%
  mutate(effect_genuine = main_valence,
         effect_deepfaked = main_valence + interaction,
         #percent_moderation = (main_experiment_condition + interaction)/main_valence *100,  # alt method, same result
         percent_comparison = (effect_deepfaked/effect_genuine)*100)

# results table
estimates_intentions <-
  map_estimate(draws_intentions) %>%
  full_join(bayestestR::hdi(draws_intentions, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_intentions, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_intentions %>%
              select(-percent_comparison) %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper,
         CI_90_lower, CI_90_upper, p)

estimates_intentions %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
main_valence	2.59	2.37	2.82	2.40	2.78	0.0000000
main_experiment_condition	-0.44	-0.65	-0.20	-0.61	-0.23	0.0000357
interaction	0.11	-0.21	0.42	-0.17	0.36	0.2766429
effect_genuine	2.59	2.37	2.82	2.40	2.78	0.0000000
effect_deepfaked	2.68	2.47	2.90	2.51	2.87	0.0000000
percent_comparison	102.64	92.28	116.89	93.40	113.96	/

# hypothesis testing
H1e <- ifelse((estimates_intentions %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H1f <- ifelse((estimates_intentions %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H2c <- ifelse((estimates_intentions %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_90_lower)) > 
                (estimates_intentions %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)), 
              "Accepted", "Rejected")

comparison_string_intentions <-
  paste0("Deepfakes are ",
         estimates_intentions %>% filter(Parameter == "percent_comparison") %>% pull(MAP_Estimate) %>% round(1), 
         "% (95% CI [",
         estimates_intentions %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_lower) %>% round(1),
         ", ",
         estimates_intentions %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_upper) %>% round(1),
         "]) as effective as genuine content in establishing self-reported evaluations")

H1e

The content of the genuine videos (i.e., Source Valence) will influence participants’ behavioral intention responses.

Result: Accepted

H1f

The content of the Deepfaked videos (i.e., Source Valence) will influence participants’ behavioral intention responses.

Result: Accepted

H2c

Change in behavioral intentions (i.e., between Source Valence conditions) induced by Deepfaked video content will be non-inferior to genuine content.

Result: Accepted. Deepfakes are 102.6% (95% CI [92.3, 116.9]) as effective as genuine content in establishing self-reported evaluations.

RQ3: How good are people at detecting Deepfakes?

Can people accurately detect deepfakes?

Youden’s J = sensitivity + specificity - 1, aka informedness, aka “the probability of an informed decision (as opposed to a random guess) and takes into account all predictions”
95% CIs were bootstrapped via case removal and the percentile method.

Sample size

data_after_exclusions %>%
  count(experiment_condition,
        deepfake_detection_closed) %>%
  drop_na() %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

experiment_condition	deepfake_detection_closed	n
genuine	genuine	184
genuine	deepfaked	120
deepfaked	genuine	109
deepfaked	deepfaked	221

Classification stats

data_classifications <- data_after_exclusions %>%
  select(experiment_condition, deepfake_detection_closed) %>%
  drop_na()

truth <- factor(data_classifications$experiment_condition,
                levels = rev(c("genuine", "deepfaked")))

pred <- factor(data_classifications$deepfake_detection_closed,
               levels = rev(c("genuine", "deepfaked")))

cm <- confusionMatrix(table(pred, truth))

fit_confirmatory_classification <-
  as_tibble(cm$byClass, rownames = "parameter") %>%
  spread(parameter, value) %>%
  mutate(balanced_accuracy = `Balanced Accuracy`,
         false_negative_rate = 1 - Sensitivity,
         false_positive_rate = 1 - Specificity,
         informedness = Sensitivity + Specificity - 1) %>%
  select(balanced_accuracy,
         informedness,
         false_negative_rate,
         false_positive_rate) %>%
  gather(variable, observed, c(balanced_accuracy, 
                               informedness, 
                               false_negative_rate, 
                               false_positive_rate))

Bootstrapped classification stats

# create bootstraps using out of bag method. makes a df with values that are collapsed dfs.
boots <- data_classifications %>%
  bootstraps(times = 2000)

# function to bootstrap classification stats and return a tibble
bootstrap_categorization_stats <- function(split) {
  
  truth <- factor(analysis(split)$experiment_condition,
                  levels = rev(c("genuine", "deepfaked")))
  
  pred <- factor(analysis(split)$deepfake_detection_closed,
                 levels = rev(c("genuine", "deepfaked")))
  
  cm <- confusionMatrix(table(pred, truth))
  
  results <-
    as_tibble(cm$byClass, rownames = "parameter") %>%
    spread(parameter, value) %>%
    mutate(balanced_accuracy = `Balanced Accuracy`,
           false_negative_rate = 1 - Sensitivity,
           false_positive_rate = 1 - Specificity,
           informedness = Sensitivity + Specificity - 1) %>%
    select(balanced_accuracy,
           informedness,
           false_negative_rate,
           false_positive_rate) 
  
  return(results)
}

# apply to each bootstrap
fit_confirmatory_classification_bootstraps <- boots %>%
  mutate(categorization_stats = future_map(splits, bootstrap_categorization_stats)) %>%
  select(-splits) %>%
  unnest(categorization_stats)

Results

classifications <- fit_confirmatory_classification_bootstraps %>%
  gather(variable, value, c(balanced_accuracy, 
                            informedness, 
                            false_negative_rate, 
                            false_positive_rate)) %>%
  group_by(variable) %>%
  summarize(ci_lower = quantile(value, 0.025),
            ci_upper = quantile(value, 0.975),
            .groups  = "drop") %>%
  full_join(fit_confirmatory_classification, by = "variable") %>%
  mutate_if(is.numeric, round, digits = 2) %>%
  select(variable, observed, ci_lower, ci_upper) 

classifications %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE)

variable	observed	ci_lower	ci_upper
balanced_accuracy	0.64	0.60	0.67
false_negative_rate	0.33	0.28	0.38
false_positive_rate	0.39	0.34	0.45
informedness	0.27	0.20	0.35

H3: Participants are poor at making accurate and informed judgements about whether online video content is genuine or Deepfaked. Our predictions here are descriptive/continuous rather than involving cut-off based inference rules.

H3a. We expect a substantial proportion of participants to be poor at correctly detecting Deepfakes. This will be examined using the false negative rate, although we do not have numerical predictions here.
H3b. We expect a substantial proportion of participants to incorrectly detect Deepfakes even when the video content was real/.This will be examined using the false positive rate, although we do not have numerical predictions here.
H3c. We expect participants to be poor at making accurate decisions about whether content is genuine or not (e.g., Balanced Accuracy not greatly above chance, circa .60), far less than what might be considered highly accurate decisions (e.g., BA of .80 or .90).
H3d. We expect participants to make poorly informed decisions about whether content is genuine or not, (e.g., informedness/Youden’s J of circa .20), far less than what might be considered highly informed decisions (e.g., J of .80 or .90).

Even the subset of participants who were aware of the concept of Deepfakes before the study?

Same descriptive predictions as above.

Sample size

data_after_exclusions %>%
  filter(deepfake_awareness_closed == "aware") %>%
  count(experiment_condition,
        deepfake_detection_closed) %>%
  drop_na() %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

experiment_condition	deepfake_detection_closed	n
genuine	genuine	100
genuine	deepfaked	62
deepfaked	genuine	50
deepfaked	deepfaked	145

Classification stats

data_classifications_subset <- data_after_exclusions %>%
  filter(deepfake_awareness_closed == "aware") %>%
  select(experiment_condition, deepfake_detection_closed) %>%
  drop_na()

truth_subset <- factor(data_classifications_subset$experiment_condition,
                levels = rev(c("genuine", "deepfaked")))

pred_subset <- factor(data_classifications_subset$deepfake_detection_closed,
               levels = rev(c("genuine", "deepfaked")))

cm_subset <- confusionMatrix(table(pred_subset, truth_subset))

fit_confirmatory_classification_subset <-
  as_tibble(cm_subset$byClass, rownames = "parameter") %>%
  spread(parameter, value) %>%
  mutate(balanced_accuracy = `Balanced Accuracy`,
         false_negative_rate = 1 - Sensitivity,
         false_positive_rate = 1 - Specificity,
         informedness = Sensitivity + Specificity - 1) %>%
  select(balanced_accuracy,
         informedness,
         false_negative_rate,
         false_positive_rate) %>%
  gather(variable, observed, c(balanced_accuracy, 
                               informedness, 
                               false_negative_rate, 
                               false_positive_rate))

Bootstrapped classification stats

# create bootstraps using out of bag method. makes a df with values that are collapsed dfs.
boots_subset <- data_classifications_subset %>%
  bootstraps(times = 2000)

# apply to each bootstrap
fit_confirmatory_classification_bootstraps_subset <- boots_subset %>%
  mutate(categorization_stats = future_map(splits, bootstrap_categorization_stats)) %>%
  select(-splits) %>%
  unnest(categorization_stats)

Results

classifications_subset <- fit_confirmatory_classification_bootstraps_subset %>%
  gather(variable, value, c(balanced_accuracy, 
                            informedness, 
                            false_negative_rate, 
                            false_positive_rate)) %>%
  group_by(variable) %>%
  summarize(ci_lower = quantile(value, 0.025),
            ci_upper = quantile(value, 0.975),
            .groups  = "drop") %>%
  full_join(fit_confirmatory_classification_subset, by = "variable") %>%
  mutate_if(is.numeric, round, digits = 2) %>%
  select(variable, observed, ci_lower, ci_upper) 

classifications_subset %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE)

variable	observed	ci_lower	ci_upper
balanced_accuracy	0.68	0.63	0.73
false_negative_rate	0.26	0.20	0.32
false_positive_rate	0.38	0.31	0.46
informedness	0.36	0.26	0.45

RQ4: Are people aware that content can be Deepfaked before they take part in the study, and does this make them better at detecting them?

Percent of participants awareness of the concept prior to study

I.e., using the full sample and reporting the sample percentage.

Description of sample:

percent_aware <- data_after_exclusions %>%
  dplyr::select(deepfake_awareness_closed) %>%
  drop_na() %>%
  count(deepfake_awareness_closed) %>%
  mutate(counts = n,
         awareness = as.factor(deepfake_awareness_closed),
         percent_aware = round(counts/sum(counts)*100, 1)) %>%
  filter(awareness == "aware") %>%
  dplyr::select(percent_aware) 

percent_aware %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

percent_aware
56.3

In the subset of participants who were shown a deepfake, did prior awareness make them more likely to detect it?

Putting aside true negatives and false positive, does prior awareness of the concept of deepfaking at least make people better at detecting deepfakes

It would of course be possible include data from both experiment_conditions and add it to the model, however interpreting the two and three way interactions is less intuitive. Given this question is of secondary importance, I we therefore elected for the simpler analysis focusing on awareness and the FNR/TPR.

Fit model

# convert data to counts
data_counts_awareness_detection <- data_after_exclusions %>%
  filter(experiment_condition == "deepfaked") %>%
  dplyr::select(experiment, deepfake_awareness_closed, deepfake_detection_closed) %>%
  drop_na() %>%
  mutate(deepfake_awareness_closed = case_when(deepfake_awareness_closed == "aware" ~ TRUE,
                                               deepfake_awareness_closed == "unaware" ~ FALSE),
         deepfake_detection_closed = case_when(deepfake_detection_closed == "deepfaked" ~ TRUE,
                                               deepfake_detection_closed == "genuine" ~ FALSE)) %>%
  count(experiment, deepfake_awareness_closed, deepfake_detection_closed) %>%
  group_by(experiment) %>%
  mutate(counts = n,
         awareness = as.factor(deepfake_awareness_closed),
         detection = as.factor(deepfake_detection_closed),
         proportion = counts/sum(counts)) %>%
  ungroup() %>%
  dplyr::select(experiment, awareness, detection, counts, proportion)

# total counts is needed later to convert to proportions
total_counts_awareness_detection <- data_counts_awareness_detection %>%
  group_by(experiment) %>%
  summarize(total = sum(counts)) %>%
  ungroup()

# fit poisson model
fit_confirmatory_poisson_awareness_detection <- 
  brm(formula = counts ~ 1 + awareness * detection,
      family  = poisson(),
      data    = data_counts_awareness_detection,
      file    = "models/fit_confirmatory_poisson_awareness_detection",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.998,
                     max_treedepth = 18),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

pp_check(fit_confirmatory_poisson_awareness_detection, nsamples = 100)

summary(fit_confirmatory_poisson_awareness_detection)

##  Family: poisson 
##   Links: mu = log 
## Formula: counts ~ 1 + awareness * detection 
##    Data: data_counts_awareness_detection (Number of observations: 4) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                             Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                       4.07      0.13     3.80     4.32 1.00     9626
## awarenessTRUE                  -0.16      0.19    -0.55     0.21 1.00     9916
## detectionTRUE                   0.25      0.18    -0.09     0.60 1.00     9993
## awarenessTRUE:detectionTRUE     0.81      0.24     0.35     1.28 1.00     9030
##                             Tail_ESS
## Intercept                      13622
## awarenessTRUE                  12404
## detectionTRUE                  13002
## awarenessTRUE:detectionTRUE    11006
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_poisson_awareness_detection, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_poisson_awareness_detection) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_awarenessTRUE	uninformative
b_detectionTRUE	uninformative
b_awarenessTRUE.detectionTRUE	uninformative

Interpret posteriors

sjPlot doesn’t behave well with these variable names for some reason. From top to bottom, the parameters are awareness, detection, and awareness*detection.

plot_model(fit_confirmatory_poisson_awareness_detection) + xlab("Parameter")

# plot(conditional_effects(fit_confirmatory_poisson_awareness_detection), ask = FALSE)

Parameter estimates

# posterior draws for parameters (for results table)
draws_awareness_detection <- posterior_samples(fit_confirmatory_poisson_awareness_detection) %>%
  dplyr::select(awarenessTRUE = b_awarenessTRUE, 
                detectionTRUE = b_detectionTRUE, 
                interaction   = `b_awarenessTRUE:detectionTRUE`) 

estimates_awareness_detection <- 
  full_join(as_tibble(map_estimate(draws_awareness_detection)),
            as_tibble(bayestestR::hdi(draws_awareness_detection, ci = .95)), 
          by = "Parameter") %>%
  # exponentiate the log IRR values to IRR
  mutate_if(is.numeric, exp) %>%
  full_join(draws_awareness_detection %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(exp(value) > 1)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  dplyr::select(Parameter, incidence_rate_ratio_MAP = MAP_Estimate, CI_95_lower = CI_low, CI_95_upper = CI_high, p) 
  # convert from odds to probability
  # mutate_if(is.numeric, function(x){x/(1+x)}) %>%
  
# table
estimates_awareness_detection %>%
  mutate_at(vars("incidence_rate_ratio_MAP", "CI_95_lower", "CI_95_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	incidence_rate_ratio_MAP	CI_95_lower	CI_95_upper	p
awarenessTRUE	0.85	0.58	1.25	0.1956071
detectionTRUE	1.30	0.91	1.82	0.0718214
interaction	2.25	1.41	3.60	0.0000714

# hypothesis testing
H4 <- ifelse((estimates_awareness_detection %>% filter(Parameter == "interaction") %>% pull(CI_95_lower)) > 1, 
              "Accepted", "Rejected")

comparison_string_awareness_detection <-
  paste0("Individuals who were aware of the concept of Deepfakes prior to participating in the study were ",
         estimates_awareness_detection %>% filter(Parameter == "interaction") %>% pull(incidence_rate_ratio_MAP) %>% round(1), 
         " times more likely to detect that they had been shown a deepfake than those who were not aware of the concept (Incidence Rate Ratio = ",
         estimates_awareness_detection %>% filter(Parameter == "interaction") %>% pull(incidence_rate_ratio_MAP) %>% round(2), 
         ", 95% CI [",
         estimates_awareness_detection %>% filter(Parameter == "interaction") %>% pull(CI_95_lower) %>% round(2),
         ", ",
         estimates_awareness_detection %>% filter(Parameter == "interaction") %>% pull(CI_95_upper) %>% round(2),
         "])")

Using the subset of participants who were in the Deepfake condition, we calculated counts for each of the combinations of the Deepfake concept check and Deepfake detection questions (e.g., awareness = TRUE & detection = TRUE, awareness = TRUE & detection = FALSE, etc.). We will then use a Bayesian Poisson model to estimate a 95% Credible Interval around the interaction effect’s Incidence Rate Ratio. A Credible Interval whose lower bound is > 1 will be considered evidence in support of this hypothesis. Estimated marginal predicted probabilities will also be reported.

Result: Accepted
Individuals who were aware of the concept of Deepfakes prior to participating in the study were 2.3 times more likely to detect that they had been shown a deepfake than those who were not aware of the concept (Incidence Rate Ratio = 2.25, 95% CI [1.41, 3.6])

Predicted probabilities

posterior_predictions_awareness_detection <-
  tibble(experiment = 7,
         awareness = c("TRUE", "FALSE"),
         detection = c("TRUE", "FALSE")) %>%
  data_grid(experiment, awareness, detection) %>%
  add_predicted_draws(model = fit_confirmatory_poisson_awareness_detection, re_formula = NULL) %>%
  rename(predicted_count = .prediction) %>%
  left_join(total_counts_awareness_detection, by = "experiment") %>%
  mutate(predicted_probabiity = predicted_count/total) %>%
  ungroup() %>%
  dplyr::select(awareness, detection, predicted_count, predicted_probabiity) 


posterior_predictions_awareness_detection_aT_dT <- posterior_predictions_awareness_detection %>% 
  filter(awareness == "TRUE" & detection == "TRUE")
posterior_predictions_awareness_detection_aT_dF <- posterior_predictions_awareness_detection %>% 
  filter(awareness == "TRUE" & detection == "FALSE")
posterior_predictions_awareness_detection_aF_dT <- posterior_predictions_awareness_detection %>% 
  filter(awareness == "FALSE" & detection == "TRUE")
posterior_predictions_awareness_detection_aF_dF <- posterior_predictions_awareness_detection %>% 
  filter(awareness == "FALSE" & detection == "FALSE")


results_detection_probabilities <- 
  rbind(
    bind_cols(as_tibble(map_estimate(posterior_predictions_awareness_detection_aT_dT$predicted_probabiity)),
              as_tibble(bayestestR::hdi(posterior_predictions_awareness_detection_aT_dT$predicted_probabiity, 
                                        ci = .95))) %>%
      mutate(awareness = "TRUE", detection = "TRUE"),
    bind_cols(as_tibble(map_estimate(posterior_predictions_awareness_detection_aT_dF$predicted_probabiity)),
              as_tibble(bayestestR::hdi(posterior_predictions_awareness_detection_aT_dF$predicted_probabiity, 
                                        ci = .95))) %>%
      mutate(awareness = "TRUE", detection = "FALSE"),
    bind_cols(as_tibble(map_estimate(posterior_predictions_awareness_detection_aF_dT$predicted_probabiity)),
              as_tibble(bayestestR::hdi(posterior_predictions_awareness_detection_aF_dT$predicted_probabiity, 
                                        ci = .95))) %>%
      mutate(awareness = "FALSE", detection = "TRUE"),
    bind_cols(as_tibble(map_estimate(posterior_predictions_awareness_detection_aF_dF$predicted_probabiity)),
              as_tibble(bayestestR::hdi(posterior_predictions_awareness_detection_aF_dF$predicted_probabiity, 
                                        ci = .95))) %>%
      mutate(awareness = "FALSE", detection = "FALSE")
  ) %>%
  dplyr::select(awareness, detection, detection_probability_MAP = value, 
                CI_95_lower = CI_low, CI_95_upper = CI_high) %>%
  mutate_if(is.numeric, round, digits = 3) 

results_detection_probabilities %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

awareness	detection	detection_probability_MAP	CI_95_lower	CI_95_upper
TRUE	TRUE	0.437	0.345	0.545
TRUE	FALSE	0.152	0.100	0.218
FALSE	TRUE	0.225	0.161	0.306
FALSE	FALSE	0.176	0.121	0.248

Probability of detecting deepfake if unaware: 0.225
Probability of detecting deepfake if aware: 0.437

RQ5: Does prior awareness of the concept of Deepfakes make people immune to their influence?

Subset who received deepfaked videos and were aware of the concept prior to the experiment. Same Bayesian multilevel models as employed above, using only source_valence as IV, i.e., to detect whether learning effects are credibly non-zero in this subset.

Sample sizes

data_aware_subset_n <- data_after_exclusions %>%
  filter(experiment_condition == "deepfaked" & deepfake_awareness_closed == "aware") %>%
  count(deepfake_awareness_closed) %>%
  mutate(proportion = round(n/sum(n), 2)) %>%
  arrange(desc(proportion))

data_aware_subset_n %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

deepfake_awareness_closed	n	proportion
aware	195	1

data_aware_subset <- data_after_exclusions %>%
  filter(experiment_condition == "deepfaked" & deepfake_awareness_closed == "aware")

Self-reported evaluations

Fit model

fit_confirmatory_selfreport_deepfaked_aware <-
  brm(formula = mean_self_reported_evaluation ~ source_valence,
      family  = gaussian(),
      data    = data_aware_subset,
      file    = "models/fit_confirmatory_selfreport_deepfaked_aware",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_selfreport_deepfaked_aware)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_self_reported_evaluation ~ source_valence 
##    Data: data_aware_subset (Number of observations: 195) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                 -1.25      0.11    -1.47    -1.04 1.00    21154
## source_valencepositive     2.11      0.15     1.82     2.41 1.00    21665
##                        Tail_ESS
## Intercept                 17317
## source_valencepositive    16631
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     1.04      0.05     0.94     1.15 1.00    22712    18843
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_selfreport_deepfaked_aware, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_selfreport_deepfaked_aware) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_confirmatory_selfreport_deepfaked_aware)
plot_model(fit_confirmatory_selfreport_deepfaked_aware, type = "pred", terms = "source_valence")

# results table
draws_sr_deepfaked_aware <-
  select(spread_draws(fit_confirmatory_selfreport_deepfaked_aware, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_aware = b_source_valencepositive)

estimates_sr_deepfaked_aware <-
  map_estimate(draws_sr_deepfaked_aware) %>%
  full_join(bayestestR::hdi(draws_sr_deepfaked_aware, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_sr_deepfaked_aware, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_sr_deepfaked_aware %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p) 

bind_rows(filter(estimates_sr, Parameter %in% c("effect_deepfaked")),
          estimates_sr_deepfaked_aware) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	2.35	2.15	2.59	2.18	2.55	0
effect_deepfaked_aware	2.10	1.83	2.41	1.87	2.35	0

# hypothesis testing
H5a <- ifelse((estimates_sr_deepfaked_aware %>% filter(Parameter == "effect_deepfaked_aware") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H5a

In the subset of participants who were shown a Deepfaked video and reported being aware of the concept of Deepfaking prior to participating in the experiment, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ self-reported evaluations.

Result: Accepted

Implicit

Fit model

fit_confirmatory_implicit_deepfaked_aware <-
  brm(formula = IAT_D2 ~ source_valence,
      family  = gaussian(),
      data    = data_aware_subset,
      file    = "models/fit_confirmatory_implicit_deepfaked_aware",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_implicit_deepfaked_aware)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: IAT_D2 ~ source_valence 
##    Data: data_aware_subset (Number of observations: 195) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                  0.18      0.10    -0.03     0.38 1.00    19749
## source_valencepositive     1.31      0.14     1.03     1.59 1.00    19653
##                        Tail_ESS
## Intercept                 17254
## source_valencepositive    17016
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     1.01      0.05     0.91     1.11 1.00    19904    15183
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_implicit_deepfaked_aware, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_implicit_deepfaked_aware) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_confirmatory_implicit_deepfaked_aware)
plot_model(fit_confirmatory_implicit_deepfaked_aware, type = "pred", terms = "source_valence")

# results table
draws_imp_deepfaked_aware <-
  select(spread_draws(fit_confirmatory_implicit_deepfaked_aware, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_aware = b_source_valencepositive)

estimates_imp_deepfaked_aware <-
  map_estimate(draws_imp_deepfaked_aware) %>%
  full_join(bayestestR::hdi(draws_imp_deepfaked_aware, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_imp_deepfaked_aware, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_imp_deepfaked_aware %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p) 

bind_rows(filter(estimates_imp, Parameter %in% c("effect_deepfaked")),
          estimates_imp_deepfaked_aware) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	1.36	1.14	1.57	1.17	1.53	0
effect_deepfaked_aware	1.29	1.03	1.59	1.07	1.54	0

# hypothesis testing
H5b <- ifelse((estimates_imp_deepfaked_aware %>% filter(Parameter == "effect_deepfaked_aware") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H5b

Result: Accepted

Behavioural intentions

Fit model

fit_confirmatory_intentions_deepfaked_aware <-
  brm(formula = mean_intentions ~ source_valence, 
      family  = gaussian(),
      data    = data_aware_subset,
      file    = "models/fit_confirmatory_intentions_deepfaked_aware",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_intentions_deepfaked_aware)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_intentions ~ source_valence 
##    Data: data_aware_subset (Number of observations: 195) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                 -5.18      0.11    -5.39    -4.97 1.00    22696
## source_valencepositive     2.50      0.15     2.20     2.79 1.00    23498
##                        Tail_ESS
## Intercept                 17280
## source_valencepositive    17370
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     1.04      0.05     0.94     1.15 1.00    23062    18671
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_intentions_deepfaked_aware, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_intentions_deepfaked_aware) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_confirmatory_intentions_deepfaked_aware)
plot_model(fit_confirmatory_intentions_deepfaked_aware, type = "pred", terms = "source_valence")

# results table
draws_intentions_deepfaked_aware <-
  select(spread_draws(fit_confirmatory_intentions_deepfaked_aware, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_aware = b_source_valencepositive)

estimates_intentions_deepfaked_aware <-
  map_estimate(draws_intentions_deepfaked_aware) %>%
  full_join(bayestestR::hdi(draws_intentions_deepfaked_aware, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_intentions_deepfaked_aware, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_intentions_deepfaked_aware %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p)

bind_rows(filter(estimates_intentions, Parameter %in% c("effect_deepfaked")),
          estimates_intentions_deepfaked_aware) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	2.68	2.47	2.90	2.51	2.87	0
effect_deepfaked_aware	2.50	2.21	2.81	2.25	2.75	0

# hypothesis testing
H5c <- ifelse((estimates_intentions_deepfaked_aware %>% filter(Parameter == "effect_deepfaked_aware") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H5c

In the subset of participants who were shown a Deepfaked video and accurately detected that the video was Deepfaked, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ behavioral intention scores.

Result: Accepted

RQ6: Does detecting that one was exposed to a Deepfake make people immune to its influence?

Subset who received deepfaked videos but also detected them. Same Bayesian multilevel models as employed above, using only source_valence as IV, i.e., to detect whether learning effects are credibly non-zero in this subset.

Sample sizes

data_detectors_subset_n <- data_after_exclusions %>%
  filter(experiment_condition == "deepfaked" & deepfake_detection_closed == "deepfaked") %>%
  count(deepfake_detection_closed) %>%
  mutate(proportion = round(n/sum(n), 2)) %>%
  arrange(desc(proportion))

data_detectors_subset_n %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

deepfake_detection_closed	n	proportion
deepfaked	221	1

data_detectors_subset <- data_after_exclusions %>%
  filter(experiment_condition == "deepfaked" & deepfake_detection_closed == "deepfaked")

Self-reported evaluations

Fit model

fit_confirmatory_selfreport_deepfaked_detected <-
  brm(formula = mean_self_reported_evaluation ~ source_valence,
      family  = gaussian(),
      data    = data_detectors_subset,
      file    = "models/fit_confirmatory_selfreport_deepfaked_detected",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_selfreport_deepfaked_detected)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_self_reported_evaluation ~ source_valence 
##    Data: data_detectors_subset (Number of observations: 221) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                 -1.40      0.09    -1.58    -1.22 1.00    22079
## source_valencepositive     2.19      0.13     1.93     2.45 1.00    22346
##                        Tail_ESS
## Intercept                 17644
## source_valencepositive    17333
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     0.98      0.05     0.89     1.08 1.00    21146    17368
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_selfreport_deepfaked_detected, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_selfreport_deepfaked_detected) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_confirmatory_selfreport_deepfaked_detected)
plot_model(fit_confirmatory_selfreport_deepfaked_detected, type = "pred", terms = "source_valence")

# results table
draws_sr_deepfaked_detected <-
  select(spread_draws(fit_confirmatory_selfreport_deepfaked_detected, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_detected = b_source_valencepositive)

estimates_sr_deepfaked_detected <-
  map_estimate(draws_sr_deepfaked_detected) %>%
  full_join(bayestestR::hdi(draws_sr_deepfaked_detected, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_sr_deepfaked_detected, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_sr_deepfaked_detected %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p) 

bind_rows(filter(estimates_sr, Parameter %in% c("effect_deepfaked")),
          estimates_sr_deepfaked_detected) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	2.35	2.15	2.59	2.18	2.55	0
effect_deepfaked_detected	2.18	1.93	2.44	1.97	2.40	0

# hypothesis testing
H6a <- ifelse((estimates_sr_deepfaked_detected %>% filter(Parameter == "effect_deepfaked_detected") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H6a

Result: Accepted

Implicit

Fit model

fit_confirmatory_implicit_deepfaked_detected <-
  brm(formula = IAT_D2 ~ source_valence,
      family  = gaussian(),
      data    = data_detectors_subset,
      file    = "models/fit_confirmatory_implicit_deepfaked_detected",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_implicit_deepfaked_detected)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: IAT_D2 ~ source_valence 
##    Data: data_detectors_subset (Number of observations: 221) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                  0.13      0.09    -0.05     0.31 1.00    22733
## source_valencepositive     1.37      0.13     1.11     1.63 1.00    23423
##                        Tail_ESS
## Intercept                 16550
## source_valencepositive    17109
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     0.99      0.05     0.90     1.08 1.00    23608    18072
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_implicit_deepfaked_detected, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_implicit_deepfaked_detected) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_confirmatory_implicit_deepfaked_detected)
plot_model(fit_confirmatory_implicit_deepfaked_detected, type = "pred", terms = "source_valence")

# results table
draws_imp_deepfaked_detected <-
  select(spread_draws(fit_confirmatory_implicit_deepfaked_detected, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_detected = b_source_valencepositive)

estimates_imp_deepfaked_detected <-
  map_estimate(draws_imp_deepfaked_detected) %>%
  full_join(bayestestR::hdi(draws_imp_deepfaked_detected, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_imp_deepfaked_detected, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_imp_deepfaked_detected %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p) 

bind_rows(filter(estimates_imp, Parameter %in% c("effect_deepfaked")),
          estimates_imp_deepfaked_detected) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	1.36	1.14	1.57	1.17	1.53	0
effect_deepfaked_detected	1.37	1.12	1.64	1.15	1.59	0

# hypothesis testing
H6b <- ifelse((estimates_imp_deepfaked_detected %>% filter(Parameter == "effect_deepfaked_detected") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H6b

Result: Accepted

Behavioural intentions

Fit model

fit_confirmatory_intentions_deepfaked_detected <-
  brm(formula = mean_intentions ~ source_valence, # no random effect for experiment as only exp 6 assessed intentions
      family  = gaussian(),
      data    = data_detectors_subset,
      file    = "models/fit_confirmatory_intentions_deepfaked_detected",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_intentions_deepfaked_detected)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_intentions ~ source_valence 
##    Data: data_detectors_subset (Number of observations: 221) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                 -5.30      0.09    -5.48    -5.13 1.00    20692
## source_valencepositive     2.58      0.13     2.33     2.83 1.00    21135
##                        Tail_ESS
## Intercept                 16877
## source_valencepositive    16779
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     0.96      0.05     0.87     1.05 1.00    21421    17374
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_intentions_deepfaked_detected, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_intentions_deepfaked_detected) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_confirmatory_intentions_deepfaked_detected)
plot_model(fit_confirmatory_intentions_deepfaked_detected, type = "pred", terms = "source_valence")

# results table
draws_intentions_deepfaked_detected <-
  select(spread_draws(fit_confirmatory_intentions_deepfaked_detected, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_detected = b_source_valencepositive)

estimates_intentions_deepfaked_detected <-
  map_estimate(draws_intentions_deepfaked_detected) %>%
  full_join(bayestestR::hdi(draws_intentions_deepfaked_detected, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_intentions_deepfaked_detected, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_intentions_deepfaked_detected %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p)

bind_rows(filter(estimates_intentions, Parameter %in% c("effect_deepfaked")),
          estimates_intentions_deepfaked_detected) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	2.68	2.47	2.90	2.51	2.87	0
effect_deepfaked_detected	2.57	2.33	2.83	2.37	2.79	0

# hypothesis testing
H6c <- ifelse((estimates_intentions_deepfaked_detected %>% filter(Parameter == "effect_deepfaked_detected") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H6c

Result: Accepted

RQ7: Does being both aware of the concept of Deepfaking before the study and correcting detecting that content is Deepfaked make you immune to its influence?

Subset who received deepfaked videos, were aware of the concept before the study, and also detected them. Same Bayesian multilevel models as employed above, using only source_valence as IV, i.e., to detect whether learning effects are credibly non-zero in this subset.

Sample sizes

data_aware_detectors_subset_n <- data_after_exclusions %>%
  filter(experiment_condition == "deepfaked" & 
           deepfake_detection_closed == "deepfaked" & 
           deepfake_awareness_closed == "aware") %>%
  count(deepfake_detection_closed, deepfake_awareness_closed) %>%
  mutate(proportion = round(n/sum(n), 2)) %>%
  arrange(desc(proportion))

data_aware_detectors_subset_n %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

deepfake_detection_closed	deepfake_awareness_closed	n	proportion
deepfaked	aware	145	1

data_aware_detectors_subset <- data_after_exclusions %>%
  filter(experiment_condition == "deepfaked" & 
           deepfake_detection_closed == "deepfaked" & 
           deepfake_awareness_closed == "aware")

Self-reported evaluations

Fit model

fit_confirmatory_selfreport_deepfaked_aware_detected <-
  brm(formula = mean_self_reported_evaluation ~ source_valence,
      family  = gaussian(),
      data    = data_aware_detectors_subset,
      file    = "models/fit_confirmatory_selfreport_deepfaked_aware_detected",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_selfreport_deepfaked_aware_detected)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_self_reported_evaluation ~ source_valence 
##    Data: data_aware_detectors_subset (Number of observations: 145) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                 -1.28      0.11    -1.50    -1.06 1.00    22539
## source_valencepositive     1.96      0.16     1.66     2.28 1.00    22518
##                        Tail_ESS
## Intercept                 16995
## source_valencepositive    17282
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     0.96      0.06     0.85     1.08 1.00    20758    16413
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_selfreport_deepfaked_aware_detected, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_selfreport_deepfaked_aware_detected) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_confirmatory_selfreport_deepfaked_aware_detected)
plot_model(fit_confirmatory_selfreport_deepfaked_aware_detected, type = "pred", terms = "source_valence")

# results table
draws_sr_deepfaked_aware_detected <-
  select(spread_draws(fit_confirmatory_selfreport_deepfaked_aware_detected, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_aware_detected = b_source_valencepositive)

estimates_sr_deepfaked_aware_detected <-
  map_estimate(draws_sr_deepfaked_aware_detected) %>%
  full_join(bayestestR::hdi(draws_sr_deepfaked_aware_detected, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_sr_deepfaked_aware_detected, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_sr_deepfaked_aware_detected %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p) 

bind_rows(filter(estimates_sr, Parameter %in% c("effect_deepfaked")),
          estimates_sr_deepfaked_aware_detected) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	2.35	2.15	2.59	2.18	2.55	0
effect_deepfaked_aware_detected	1.98	1.65	2.27	1.70	2.21	0

# hypothesis testing
H7a <- ifelse((estimates_sr_deepfaked_aware_detected %>% filter(Parameter == "effect_deepfaked_aware_detected") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H7a

In the subset of participants who were shown a Deepfaked video, reported being aware of the concept of Deepfakes, and accurately detected that the video was Deepfaked, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ self-reported evaluations.

Result: Accepted

Implicit

Fit model

fit_confirmatory_implicit_deepfaked_aware_detected <-
  brm(formula = IAT_D2 ~ source_valence,
      family  = gaussian(),
      data    = data_aware_detectors_subset,
      file    = "models/fit_confirmatory_implicit_deepfaked_aware_detected",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_implicit_deepfaked_aware_detected)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: IAT_D2 ~ source_valence 
##    Data: data_aware_detectors_subset (Number of observations: 145) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                  0.18      0.12    -0.05     0.41 1.00    20967
## source_valencepositive     1.33      0.16     1.00     1.65 1.00    21336
##                        Tail_ESS
## Intercept                 16811
## source_valencepositive    17624
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     0.99      0.06     0.88     1.12 1.00    20438    16754
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_implicit_deepfaked_aware_detected, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_implicit_deepfaked_aware_detected) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_confirmatory_implicit_deepfaked_aware_detected)
plot_model(fit_confirmatory_implicit_deepfaked_aware_detected, type = "pred", terms = "source_valence")

# results table
draws_imp_deepfaked_aware_detected <-
  select(spread_draws(fit_confirmatory_implicit_deepfaked_aware_detected, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_aware_detected = b_source_valencepositive)

estimates_imp_deepfaked_aware_detected <-
  map_estimate(draws_imp_deepfaked_aware_detected) %>%
  full_join(bayestestR::hdi(draws_imp_deepfaked_aware_detected, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_imp_deepfaked_aware_detected, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_imp_deepfaked_aware_detected %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p) 

bind_rows(filter(estimates_imp, Parameter %in% c("effect_deepfaked")),
          estimates_imp_deepfaked_aware_detected) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	1.36	1.14	1.57	1.17	1.53	0
effect_deepfaked_aware_detected	1.35	1.01	1.65	1.06	1.60	0

# hypothesis testing
H7b <- ifelse((estimates_imp_deepfaked_aware_detected %>% filter(Parameter == "effect_deepfaked_aware_detected") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H7b

Result: Accepted

Behavioural intentions

Fit model

fit_confirmatory_intentions_deepfaked_aware_detected <-
  brm(formula = mean_intentions ~ source_valence, # no random effect for experiment as only exp 6 assessed intentions
      family  = gaussian(),
      data    = data_aware_detectors_subset,
      file    = "models/fit_confirmatory_intentions_deepfaked_aware_detected",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_intentions_deepfaked_aware_detected)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_intentions ~ source_valence 
##    Data: data_aware_detectors_subset (Number of observations: 145) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                 -5.23      0.11    -5.45    -5.00 1.00    21238
## source_valencepositive     2.38      0.16     2.07     2.70 1.00    19802
##                        Tail_ESS
## Intercept                 17340
## source_valencepositive    17057
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     0.97      0.06     0.86     1.09 1.00    20368    16850
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_intentions_deepfaked_aware_detected, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_intentions_deepfaked_aware_detected) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_confirmatory_intentions_deepfaked_aware_detected)
plot_model(fit_confirmatory_intentions_deepfaked_aware_detected, type = "pred", terms = "source_valence")

# results table
draws_intentions_deepfaked_aware_detected <-
  select(spread_draws(fit_confirmatory_intentions_deepfaked_aware_detected, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_aware_detected = b_source_valencepositive)

estimates_intentions_deepfaked_aware_detected <-
  map_estimate(draws_intentions_deepfaked_aware_detected) %>%
  full_join(bayestestR::hdi(draws_intentions_deepfaked_aware_detected, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_intentions_deepfaked_aware_detected, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_intentions_deepfaked_aware_detected %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p)

bind_rows(filter(estimates_intentions, Parameter %in% c("effect_deepfaked")),
          estimates_intentions_deepfaked_aware_detected) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	2.68	2.47	2.9	2.51	2.87	0
effect_deepfaked_aware_detected	2.39	2.07	2.7	2.12	2.65	0

# hypothesis testing
H7c <- ifelse((estimates_intentions_deepfaked_aware_detected %>% filter(Parameter == "effect_deepfaked_aware_detected") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H7c

Result: Accepted

Summary of hypothesis tests

H1: Establishing first impressions via online video content

Genuine content can establish self-reported evaluations (Accepted), implicit evaluations (Accepted), and behavioural intentions (Accepted).
Deepfaked content can establish self-reported evaluations (Accepted), implicit evaluations (Accepted), and behavioural intentions (Accepted).

H2: Are deepfakes just as good as the real thing?

Deepfakes are non-inferior to genuine content on self-reported evaluations (Rejected), implicit evaluations (Accepted), and behavioural intentions (Accepted).

H3: How good are people at detecting whether content is genuine or Deepfaked?

Whole sample

classifications %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE)

variable	observed	ci_lower	ci_upper
balanced_accuracy	0.64	0.60	0.67
false_negative_rate	0.33	0.28	0.38
false_positive_rate	0.39	0.34	0.45
informedness	0.27	0.20	0.35

Those who were aware of the concept prior to the study

classifications_subset %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE)

variable	observed	ci_lower	ci_upper
balanced_accuracy	0.68	0.63	0.73
false_negative_rate	0.26	0.20	0.32
false_positive_rate	0.38	0.31	0.46
informedness	0.36	0.26	0.45

H4: Does prior awareness of the concept of Deepfakes make people better at detecting them?

Percent aware of the concept of Deepfakes: 56.3
Of those exposed to a Deepfake, Individuals who were aware of the concept of Deepfakes prior to participating in the study were 2.3 times more likely to detect that they had been shown a deepfake than those who were not aware of the concept (Incidence Rate Ratio = 2.25, 95% CI [1.41, 3.6]), Accepted.

H5-7: Does being aware of the concept, detecitng the deepfake, or both make you immune to a Deepfake?

H5: Evaluative learning effects found in the subset who were shown Deepfakes and were aware of the concept, on self-reports (Accepted), implicit measure (Accepted) and behavioural intentions (Accepted).
H6: Evaluative learning effects found in the subset who were shown Deepfakes and detected them, on self-reports (Accepted), implicit measure (Accepted) and behavioural intentions (Accepted).
H6: Evaluative learning effects found in the subset who were shown Deepfakes, were aware of the concept, and detected them, on self-reports (Accepted), implicit measure (Accepted) and behavioural intentions (Accepted).

Session Info

sessionInfo()

## R version 4.0.2 (2020-06-22)
## Platform: x86_64-apple-darwin17.0 (64-bit)
## Running under: macOS  10.16
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRblas.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRlapack.dylib
## 
## locale:
## [1] en_IE.UTF-8/en_IE.UTF-8/en_IE.UTF-8/C/en_IE.UTF-8/en_IE.UTF-8
## 
## attached base packages:
## [1] parallel  stats     graphics  grDevices utils     datasets  methods  
## [8] base     
## 
## other attached packages:
##  [1] e1071_1.7-3      caret_6.0-86     lattice_0.20-41  furrr_0.2.1     
##  [5] future_1.19.1    modelr_0.1.8     semTools_0.5-3   lavaan_0.6-7    
##  [9] IATscores_0.2.7  broom_0.7.2      rsample_0.0.7    psych_2.0.9     
## [13] sjPlot_2.8.4     bayestestR_0.7.5 tidybayes_2.0.3  brms_2.14.0     
## [17] Rcpp_1.0.5       kableExtra_1.3.1 knitr_1.30       forcats_0.5.0   
## [21] stringr_1.4.0    dplyr_1.0.2      purrr_0.3.4      readr_1.3.1     
## [25] tidyr_1.1.2      tibble_3.0.4     ggplot2_3.3.2    tidyverse_1.3.0 
## 
## loaded via a namespace (and not attached):
##   [1] tidyselect_1.1.0     lme4_1.1-25          htmlwidgets_1.5.1   
##   [4] grid_4.0.2           pROC_1.16.2          munsell_0.5.0       
##   [7] codetools_0.2-16     effectsize_0.4.0     statmod_1.4.34      
##  [10] DT_0.13              miniUI_0.1.1.1       withr_2.3.0         
##  [13] Brobdingnag_1.2-6    colorspace_2.0-0     highr_0.8           
##  [16] rstudioapi_0.13      stats4_4.0.2         bayesplot_1.7.2     
##  [19] listenv_0.8.0        labeling_0.4.2       huge_1.3.4.1        
##  [22] emmeans_1.4.6        rstan_2.21.2         mnormt_1.5-7        
##  [25] farver_2.0.3         bridgesampling_1.0-0 coda_0.19-3         
##  [28] vctrs_0.3.5          generics_0.0.2       TH.data_1.0-10      
##  [31] ipred_0.9-9          xfun_0.19            R6_2.5.0            
##  [34] markdown_1.1         assertthat_0.2.1     promises_1.1.0      
##  [37] scales_1.1.1         multcomp_1.4-13      nnet_7.3-14         
##  [40] gtable_0.3.0         globals_0.13.1       processx_3.4.4      
##  [43] sandwich_2.5-1       timeDate_3043.102    rlang_0.4.8         
##  [46] splines_4.0.2        ModelMetrics_1.2.2.2 checkmate_2.0.0     
##  [49] inline_0.3.16        yaml_2.2.1           reshape2_1.4.4      
##  [52] abind_1.4-5          d3Network_0.5.2.1    threejs_0.3.3       
##  [55] crosstalk_1.1.0.1    backports_1.1.9      httpuv_1.5.2        
##  [58] rsconnect_0.8.16     Hmisc_4.4-1          lava_1.6.7          
##  [61] tools_4.0.2          ellipsis_0.3.1       RColorBrewer_1.1-2  
##  [64] ggridges_0.5.2       plyr_1.8.6           base64enc_0.1-3     
##  [67] ps_1.4.0             prettyunits_1.1.1    rpart_4.1-15        
##  [70] pbapply_1.4-2        zoo_1.8-8            qgraph_1.6.5        
##  [73] haven_2.3.1          cluster_2.1.0        fs_1.4.1            
##  [76] magrittr_2.0.1       data.table_1.13.2    colourpicker_1.0    
##  [79] reprex_0.3.0         mvtnorm_1.1-1        whisker_0.4         
##  [82] sjmisc_2.8.5         matrixStats_0.56.0   hms_0.5.3           
##  [85] shinyjs_1.1          mime_0.9             evaluate_0.14       
##  [88] arrayhelpers_1.1-0   xtable_1.8-4         shinystan_2.5.0     
##  [91] sjstats_0.18.0       jpeg_0.1-8.1         readxl_1.3.1        
##  [94] gridExtra_2.3        ggeffects_0.14.3     rstantools_2.1.1    
##  [97] compiler_4.0.2       V8_3.2.0             crayon_1.3.4        
## [100] minqa_1.2.4          StanHeaders_2.21.0-6 htmltools_0.5.0     
## [103] corpcor_1.6.9        later_1.0.0          Formula_1.2-3       
## [106] RcppParallel_5.0.2   lubridate_1.7.9      DBI_1.1.0           
## [109] sjlabelled_1.1.7     dbplyr_1.4.3         MASS_7.3-53         
## [112] boot_1.3-25          Matrix_1.2-18        cli_2.1.0           
## [115] gower_0.2.2          insight_0.10.0       igraph_1.2.5        
## [118] BDgraph_2.62         pkgconfig_2.0.3      foreign_0.8-80      
## [121] recipes_0.1.13       foreach_1.5.0        xml2_1.3.2          
## [124] svUnit_1.0.3         pbivnorm_0.6.0       dygraphs_1.1.1.6    
## [127] webshot_0.5.2        prodlim_2019.11.13   estimability_1.3    
## [130] rvest_0.3.5          snakecase_0.11.0     callr_3.5.1         
## [133] digest_0.6.27        parameters_0.8.6     rmarkdown_2.5       
## [136] cellranger_1.1.0     htmlTable_1.13.3     curl_4.3            
## [139] shiny_1.5.0          gtools_3.8.2         rjson_0.2.20        
## [142] nloptr_1.2.2.2       glasso_1.11          lifecycle_0.2.0     
## [145] nlme_3.1-148         jsonlite_1.7.1       viridisLite_0.3.0   
## [148] fansi_0.4.1          pillar_1.4.6         loo_2.3.1           
## [151] fastmap_1.0.1        httr_1.4.1           pkgbuild_1.1.0      
## [154] survival_3.1-12      glue_1.4.2           xts_0.12-0          
## [157] fdrtool_1.2.15       iterators_1.0.12     png_0.1-7           
## [160] shinythemes_1.1.2    class_7.3-17         stringi_1.4.6       
## [163] performance_0.4.6    latticeExtra_0.6-29

Analyses

Preregistered analyses for experiment 7

Ian Hussey

08 December 2020

Dependencies & functions

Exclusions & standaridization

Distributions

Demographics

Pre exclussion

Post exclusions

Internal consistency

Self-reported evaluations

IAT

Behavioral intentions

RQ1 & 2: Can online content establish first impressions towards a novel individual?; Are Deepfakes just as good as genuine online content at establishing first impressions?

Sample sizes

Self-reported evaluations

Fit model

Inspect convergence

Check informativeness of prior

Interpret posteriors

Implicit

Fit model

Inspect convergence

Check informativeness of prior

Interpret posteriors

Behavioural intentions

Fit model

Inspect convergence

Check informativeness of prior

Interpret posteriors

RQ3: How good are people at detecting Deepfakes?

Can people accurately detect deepfakes?

Sample size

Classification stats

Bootstrapped classification stats

Results

Even the subset of participants who were aware of the concept of Deepfakes before the study?

Sample size

Classification stats

Bootstrapped classification stats

Results

RQ4: Are people aware that content can be Deepfaked before they take part in the study, and does this make them better at detecting them?

Percent of participants awareness of the concept prior to study

In the subset of participants who were shown a deepfake, did prior awareness make them more likely to detect it?

Fit model

Inspect convergence

Check informativeness of prior

Interpret posteriors

Parameter estimates

Predicted probabilities

RQ5: Does prior awareness of the concept of Deepfakes make people immune to their influence?

Sample sizes

Self-reported evaluations

Fit model

Inspect convergence

Check informativeness of prior

Interpret posteriors

Implicit

Fit model

Inspect convergence

Check informativeness of prior

Interpret posteriors

Behavioural intentions

Fit model

Inspect convergence

Check informativeness of prior

Interpret posteriors

RQ6: Does detecting that one was exposed to a Deepfake make people immune to its influence?

Sample sizes

Self-reported evaluations

Fit model

Inspect convergence

Check informativeness of prior

Interpret posteriors

Implicit

Fit model

Inspect convergence

Check informativeness of prior

Interpret posteriors